home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Creative Computers
/
Creative Computers CD-ROM, Volume 1 (Legendary Design Technologies, Inc.)(1994).iso
/
shareware
/
fractals
/
ffex
/
source
/
render.mod
< prev
next >
Wrap
Text File
|
1994-11-17
|
6KB
|
184 lines
IMPLEMENTATION MODULE Render;
FROM Arts IMPORT TermProcedure, Assert;
FROM SYSTEM IMPORT ADR,ADDRESS,INLINE;
FROM Intuition IMPORT WindowPtr,SetPointer;
FROM Exec IMPORT CopyMem,AllocMem,FreeMem,MemReqs,MemReqSet,TypeOfMem;
CONST
MAX16=4096.0; (* 2^12 Multiplikator für Int16 *)
MAX32=268435456.0; (* 2^28 Multiplikator für Int32 *)
(*** Prozeduren für Fraktalgrafik ************************************)
PROCEDURE SetPixel(x{0},y{1},col{2},maxit{3},
maxcol{4}:LONGINT;plane0Ptr{8}:ADDRESS);
(* $E- schneller als WritePixel, direkt in die BitMap! *)
BEGIN
INLINE(0B483H,06C00H,0002EH,084C4H,04242H,04842H,05242H,02800H,
0E68CH,00240H,00007H,07A07H,09A40H,0D881H,02258H,00802H,
00000H,06700H,00006H,0D3C4H,00BD1H,0E20AH,04A02H,06600H,
0FFECH,04E75H);
END SetPixel;
PROCEDURE GetPixel(x{0},y{1},planes{2}:LONGINT;
plane0Ptr{8}:ADDRESS):LONGINT;
(* $E- $F- schneller als ReadPixel *)
BEGIN
INLINE(05342H,02600H,0E68BH,00240H,00007H,07807H,09840H,0203CH,
00000H,00000H,07A00H,0D681H,02258H,0D3C3H,00911H,06700H,
00004H,00BC0H,05245H,051CAH,0FFF0H,04E75H);
END GetPixel;
PROCEDURE FastIter32(cx,cy:LONGREAL;maxiter:LONGINT):LONGINT;
PROCEDURE Assem(cx{0},cy{1},max{2}:LONGINT):LONGINT;
(* $E- $F- Assemblerprogramm für INT32 *)
BEGIN
INLINE(048E7H,01FF8H,02440H,02641H,02842H,02E3CH,00000H,
00000H,0227CH,00000H,00000H,0207CH,00000H,00000H,02008H,
06A00H,00004H,04480H,03200H,04840H,0C2C0H,0E389H,03801H,
0243CH,00000H,00000H,0E352H,04842H,04241H,04841H,0C0C0H,
0D081H,06900H,000DAH,0D082H,06900H,000D4H,0E980H,06900H,
000CEH,0183CH,00000H,0E95CH,08004H,02800H,02009H,06A00H,
00004H,04480H,03200H,04840H,0C2C0H,0E389H,03A01H,0243CH,
00000H,00000H,0E352H,04842H,04241H,04841H,0C0C0H,0D081H,
06900H,0009CH,0D082H,06900H,00096H,0E980H,06900H,00090H,
01A3CH,00000H,0E95DH,08005H,06900H,00084H,02A00H,0D084H,
06900H,0007CH,09885H,0D88AH,02C3CH,00000H,00000H,02008H,
06A00H,00006H,04480H,05246H,03400H,04840H,02209H,06A00H,
00006H,04481H,05246H,03601H,04841H,0C6C0H,0C4C1H,0C0C1H,
0D682H,03A03H,0223CH,00000H,00000H,0E351H,04841H,04243H,
04843H,0D083H,06900H,00038H,0D081H,06900H,00032H,0E980H,
06900H,0002CH,01A3CH,00000H,0E95DH,08005H,00806H,00000H,
06700H,00004H,04480H,0E388H,06900H,00014H,0D08BH,06900H,
0000EH,02240H,02044H,05247H,0BE8CH,06600H,0FF02H,02007H,
04CDFH,01FF8H,04E75H);
END Assem;
BEGIN
RETURN Assem(LONGINT(cx*MAX32),LONGINT(cy*MAX32),maxiter)
END FastIter32;
PROCEDURE FastIter16(cx,cy:LONGREAL; maxiter:LONGINT):LONGINT;
PROCEDURE Assem(cx{0},cy{1},max{2}:LONGINT):LONGINT;
(* $E- $F- Assemblerprogramm für INT16 *)
BEGIN
INLINE(0207CH,00000H,00000H,0227CH,00000H,00000H,02E3CH,
00000H,00000H,02608H,0C7C3H,0E983H,06900H,00038H,04243H,
04843H,02809H,0C9C4H,0E984H,06900H,0002AH,04244H,04844H,
02A04H,0DA43H,06B00H,0001EH,03A08H,03C09H,0CBC6H,0EB85H,
04845H,0DA41H,03245H,03A03H,09A44H,0DA40H,03045H,05247H,
051CAH,0FFC2H,02007H,04E75H);
END Assem;
BEGIN
RETURN Assem(LONGINT(cx*MAX16),LONGINT(cy*MAX16),maxiter)
END FastIter16;
PROCEDURE LongRealIter(cx,cy:LONGREAL; maxiter:LONGINT):LONGINT;
(* der normale Mandelbrot-Algorithmus: z:=z^2+c *)
VAR
zi,zr,zi2,zr2:LONGREAL;
count:LONGINT;
BEGIN
zr:=0.0;zi:=0.0;count:=0;
LOOP
zr2:=zr*zr;zi2:=zi*zi;
IF (zr2+zi2)>8.0 THEN EXIT END;
zi:=zr*zi;zi:=zi+zi+cy;zr:=zr2-zi2+cx;INC(count);
IF count=maxiter THEN EXIT END;
END;
RETURN count;
END LongRealIter;
(*** INLINE Daten und Prozeduren für Mauszeiger **********************)
VAR NormalPointer,ZZZPointer,ZoomPointer : ADDRESS;
PROCEDURE NormalPointerData; (* $E- *)
BEGIN
INLINE(00000H,00000H,04000H,08000H,0B000H,0C000H,04C00H,07000H,
04300H,07C00H,020C0H,03F00H,02000H,03FC0H,01100H,01E00H,
01280H,01F00H,00940H,00D80H,008A0H,00CC0H,00040H,00060H,
00000H,00000H)
END NormalPointerData;
PROCEDURE ZZZPointerData; (* $E- *)
BEGIN
INLINE(00000H,00000H,0FFE0H,00000H,08020H,00000H,08020H,00000H,
0C060H,04040H,071C0H,03180H,07FC0H,03F80H,03F80H,00E00H,
00E00H,00400H,03580H,00400H,04040H,00000H,04040H,00000H,
08420H,00400H,09F20H,01F00H,0FFE0H,07FC0H,0FFE0H,00000H,
00000H,00000H);
END ZZZPointerData;
PROCEDURE ZoomPointerData; (* $E- *)
BEGIN
INLINE(00000H,00000H,00000H,01E00H,00000H,07380H,00800H,04080H,
01000H,0C0C0H,00000H,08040H,00000H,08040H,00000H,0C0C0H,
00000H,04080H,00040H,07380H,021A0H,03FC0H,01E50H,01E60H,
00028H,00030H,00010H,00018H,00000H,00000H);
END ZoomPointerData;
PROCEDURE SetNormalPointer(win:WindowPtr);
BEGIN
SetPointer(win,NormalPointer,0BH,16,0,0);
END SetNormalPointer;
PROCEDURE SetZZZPointer(win:WindowPtr);
BEGIN
SetPointer(win,ZZZPointer,0FH,16,-8,-10);
END SetZZZPointer;
PROCEDURE SetZoomPointer(win:WindowPtr);
BEGIN
SetPointer(win,ZoomPointer,0DH,16,-5,-5);
END SetZoomPointer;
PROCEDURE Cleanup;
BEGIN
IF NormalPointer#NIL THEN FreeMem(NormalPointer,4*0DH) END;
IF ZZZPointer#NIL THEN FreeMem(ZZZPointer,4*011H) END;
IF ZoomPointer#NIL THEN FreeMem(ZoomPointer,4*0FH) END;
END Cleanup;
BEGIN
TermProcedure(Cleanup);
(*** Pointerdaten falls nötig ins Chipmem kopieren. ***)
NormalPointer := ADR(NormalPointerData);
IF NOT (chip IN TypeOfMem(NormalPointer)) THEN
NormalPointer := AllocMem(4*0DH,MemReqSet{chip,memClear});
Assert(NormalPointer#NIL,ADR("AllocMem() failed!"));
CopyMem(ADR(NormalPointerData),NormalPointer,4*0DH);
END;
ZZZPointer := ADR(ZZZPointerData);
IF NOT (chip IN TypeOfMem(ZZZPointer)) THEN
ZZZPointer := AllocMem(4*11H,MemReqSet{chip,memClear});
Assert(ZZZPointer#NIL,ADR("AllocMem() failed!"));
CopyMem(ADR(ZZZPointerData),ZZZPointer,4*11H);
END;
ZoomPointer := ADR(ZoomPointerData);
IF NOT (chip IN TypeOfMem(ZoomPointer)) THEN
ZoomPointer := AllocMem(4*0FH,MemReqSet{chip,memClear});
Assert(ZoomPointer#NIL,ADR("AllocMem() failed!"));
CopyMem(ADR(ZoomPointerData),ZoomPointer,4*0FH);
END;
END Render.mod